home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / linpklib / sgtsl.for < prev    next >
Text File  |  1985-01-12  |  3KB  |  120 lines
  1.       SUBROUTINE SGTSL(N,C,D,E,B,INFO)
  2.       INTEGER N,INFO
  3.       REAL C(1),D(1),E(1),B(1)
  4. C
  5. C     SGTSL GIVEN A GENERAL TRIDIAGONAL MATRIX AND A RIGHT HAND
  6. C     SIDE WILL FIND THE SOLUTION.
  7. C
  8. C     ON ENTRY
  9. C
  10. C        N       INTEGER
  11. C                IS THE ORDER OF THE TRIDIAGONAL MATRIX.
  12. C
  13. C        C       REAL(N)
  14. C                IS THE SUBDIAGONAL OF THE TRIDIAGONAL MATRIX.
  15. C                C(2) THROUGH C(N) SHOULD CONTAIN THE SUBDIAGONAL.
  16. C                ON OUTPUT C IS DESTROYED.
  17. C
  18. C        D       REAL(N)
  19. C                IS THE DIAGONAL OF THE TRIDIAGONAL MATRIX.
  20. C                ON OUTPUT D IS DESTROYED.
  21. C
  22. C        E       REAL(N)
  23. C                IS THE SUPERDIAGONAL OF THE TRIDIAGONAL MATRIX.
  24. C                E(1) THROUGH E(N-1) SHOULD CONTAIN THE SUPERDIAGONAL.
  25. C                ON OUTPUT E IS DESTROYED.
  26. C
  27. C        B       REAL(N)
  28. C                IS THE RIGHT HAND SIDE VECTOR.
  29. C
  30. C     ON RETURN
  31. C
  32. C        B       IS THE SOLUTION VECTOR.
  33. C
  34. C        INFO    INTEGER
  35. C                = 0 NORMAL VALUE.
  36. C                = K IF THE K-TH ELEMENT OF THE DIAGONAL BECOMES
  37. C                    EXACTLY ZERO.  THE SUBROUTINE RETURNS WHEN
  38. C                    THIS IS DETECTED.
  39. C
  40. C     LINPACK. THIS VERSION DATED 08/14/78 .
  41. C     JACK DONGARRA, ARGONNE NATIONAL LABORATORY.
  42. C
  43. C     NO EXTERNALS
  44. C     FORTRAN ABS
  45. C
  46. C     INTERNAL VARIABLES
  47. C
  48.       INTEGER K,KB,KP1,NM1,NM2
  49.       REAL T
  50. C     BEGIN BLOCK PERMITTING ...EXITS TO 100
  51. C
  52.          INFO = 0
  53.          C(1) = D(1)
  54.          NM1 = N - 1
  55.          IF (NM1 .LT. 1) GO TO 40
  56.             D(1) = E(1)
  57.             E(1) = 0.0E0
  58.             E(N) = 0.0E0
  59. C
  60.             DO 30 K = 1, NM1
  61.                KP1 = K + 1
  62. C
  63. C              FIND THE LARGEST OF THE TWO ROWS
  64. C
  65.                IF (ABS(C(KP1)) .LT. ABS(C(K))) GO TO 10
  66. C
  67. C                 INTERCHANGE ROW
  68. C
  69.                   T = C(KP1)
  70.                   C(KP1) = C(K)
  71.                   C(K) = T
  72.                   T = D(KP1)
  73.                   D(KP1) = D(K)
  74.                   D(K) = T
  75.                   T = E(KP1)
  76.                   E(KP1) = E(K)
  77.                   E(K) = T
  78.                   T = B(KP1)
  79.                   B(KP1) = B(K)
  80.                   B(K) = T
  81.    10          CONTINUE
  82. C
  83. C              ZERO ELEMENTS
  84. C
  85.                IF (C(K) .NE. 0.0E0) GO TO 20
  86.                   INFO = K
  87. C     ............EXIT
  88.                   GO TO 100
  89.    20          CONTINUE
  90.                T = -C(KP1)/C(K)
  91.                C(KP1) = D(KP1) + T*D(K)
  92.                D(KP1) = E(KP1) + T*E(K)
  93.                E(KP1) = 0.0E0
  94.                B(KP1) = B(KP1) + T*B(K)
  95.    30       CONTINUE
  96.    40    CONTINUE
  97.          IF (C(N) .NE. 0.0E0) GO TO 50
  98.             INFO = N
  99.          GO TO 90
  100.    50    CONTINUE
  101. C
  102. C           BACK SOLVE
  103. C
  104.             NM2 = N - 2
  105.             B(N) = B(N)/C(N)
  106.             IF (N .EQ. 1) GO TO 80
  107.                B(NM1) = (B(NM1) - D(NM1)*B(N))/C(NM1)
  108.                IF (NM2 .LT. 1) GO TO 70
  109.                DO 60 KB = 1, NM2
  110.                   K = NM2 - KB + 1
  111.                   B(K) = (B(K) - D(K)*B(K+1) - E(K)*B(K+2))/C(K)
  112.    60          CONTINUE
  113.    70          CONTINUE
  114.    80       CONTINUE
  115.    90    CONTINUE
  116.   100 CONTINUE
  117. C
  118.       RETURN
  119.       END
  120.